unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, MMSystem, StdCtrls, ComCtrls,
  VSample, VFrames, BlobDetection, GR32_Image;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    ComboBox1: TComboBox;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    CheckBox1: TCheckBox;
    TrackBar1: TTrackBar;
    TrackBar2: TTrackBar;
    Label2: TLabel;
    Label3: TLabel;
    CheckBox2: TCheckBox;
    CheckBox4: TCheckBox;
    TrackBar6: TTrackBar;
    Label7: TLabel;
    TrackBar7: TTrackBar;
    Image4: TImage;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Button1: TButton;
    Button5: TButton;
    CheckBox3: TCheckBox;
    Image321: TImage32;
    procedure Button2Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
    procedure TrackBar2Change(Sender: TObject);
    procedure TrackBar6Change(Sender: TObject);
    procedure TrackBar7Change(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
  private
    fFrameCnt    : integer;
    f30FrameTick : integer;
    VideoImage   : TVideoImage;
    VideoBM      : TBitmap;
    fClosing     : boolean;
    fProcessing  : boolean;
    procedure CleanPaintBoxVideo;
    procedure OnNewFrame ( var Msg: TMessage ); message WM_NewFrame;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

  // found points
  Data_Points: array [ 1..20 ] of TData;

  // Finger koordinaten
  Finger: array [ 1..20 ] of TFinger;

implementation

{$R *.dfm}

// - A new video frame has arrived...
procedure TForm1.OnNewFrame ( var Msg: TMessage );
var
  T1 : integer;
  Counter: SmallInt;
begin
  Inc ( fFrameCnt );
  // If application is closing, or processing a video frame is already active,
  // bail out...
  if fClosing or fProcessing then exit;

  // Processing active!
  fProcessing := true;

  try
    // Tell VideoImage that a new video frame has arrived.
    // This will do the painting if VideoImage.SetDisplayCanvas has been
    // called previously
    VideoImage.OnNewFrame ( Msg );

    // Calculate "Frames per second"...
    if fFrameCnt mod 30 = 0 then begin
      T1 := TimeGetTime;
      if f30FrameTick > 0 then
        Form1.Label1.Caption := 'fps: '
                                + FormatFloat ( '0.00', 30000
                                                / ( T1 - f30FrameTick ) );
      f30FrameTick := T1;
    end;

    // Drawing bitmaps without use of VideoImage.SetDisplayCanvas...
    VideoImage.Getbitmap ( Image321.Bitmap );

    //Form1.Image321.Bitmap.Assign(Form1.VideoBM );

    if Form1.CheckBox2.Checked then
      SplitBlur ( Form1.VideoBM, Form1.VideoBM, 2 );

    if Form1.CheckBox1.Checked then
    {  GCPM_Filter ( Image321.Bitmap,
                    Image321.Bitmap,
                    Form1.TrackBar1.Position,
                    Form1.TrackBar6.Position,
                    Form1.TrackBar2.Position );

     }
    if Form1.CheckBox4.Checked then begin
      Blob_Detection ( Image321.Bitmap,
                       Data_Points, 255);
      Blob_Tracking ( Data_Points,
                      Finger,
                      Form1.Image321.Canvas,
                      20, 10, 200, true, false );
    end;

    if Form1.CheckBox3.Checked then begin
      Form1.Image4.Canvas.Brush.Color := clWhite;
      Form1.Image4.Canvas.Rectangle ( Form1.Image4.ClientRect );
      for Counter := 1 to High ( Finger ) do
        if Finger [ Counter ].used then
          Form1.Image4.Canvas.TextOut ( 10, Counter * 15, inttostr ( Counter ) + ' : ' + inttostr ( Finger [ Counter ].Coords.X ) + '|' + inttostr ( Finger [ Counter ].Coords.Y ) + ' ' + inttostr ( Finger [ Counter ].lastFoundTime ) );
    end;
//    Form1.Image1.Canvas.Draw ( 0, 0, Form1.VideoBM );

  finally
    fProcessing := false;
  end;
end;

procedure TForm1.CleanPaintBoxVideo;
begin
  Image321.Canvas.Brush.Color := Color;
  Image321.Canvas.rectangle(-1, -1, Image321.Width+1, Image321.Height+1);
end;

procedure Init_WebCam;
var
  SL : TStringList;
begin
  // Load ComboBox_Cams with list of available video interfaces (WebCams...)
  SL := TStringList.Create;
  GetCaptureDeviceList ( SL );
  Form1.ComboBox1.Items.Assign ( SL );
  SL.Free;

  // At least one WebCam found: enable "Run video" button
  if Form1.ComboBox1.Items.Count > 0 then begin
    Form1.ComboBox1.ItemIndex := 0;
    Form1.Button2.Enabled := true;
    Form1.Button3.Enabled := true;
    Form1.Button4.Enabled := true;
  end;

  // Instantiate TVideoImage
  Form1.VideoImage := TVideoImage.Create;
  // For automatically draw video frames on paintbox
//  Form1.VideoImage.SetDisplayCanvas( Form1.Image1.Canvas);

  // If we would not use VideoImage.SetDisplayCanvas, we could use a bitmap for
  // drawing the video stream
  Form1.VideoBM := TBitmap.Create;
  Form1.VideoBM.PixelFormat := pf24bit;

  // Initialize some flags
  Form1.fClosing := false;
  Form1.fProcessing := false;
end; // Init_Webcam

procedure TForm1.Button2Click(Sender: TObject);
begin
  with Form1.ComboBox1 do
    if VideoImage.VideoStart ( Items [ ItemIndex ] ) <> 0 then begin
      MessageDlg ( 'Error: cannot clip webcam', mtError, [ mbOK ], 0 );
      exit;
    end;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  fClosing := true;
  CanClose := not fProcessing; // Cannot close while image copy action
  if fProcessing then
    PostMessage ( self.Handle, wm_close, 0, 0 )
  else begin
    VideoImage.VideoStop;
    Form1.VideoImage.Free;
    Form1.VideoBM.FreeImage;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Init_Webcam;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  VideoImage.ShowProperty_Stream;
  CleanPaintBoxVideo;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  VideoImage.ShowProperty;
  CleanPaintBoxVideo;
end;

procedure TForm1.TrackBar1Change(Sender: TObject);
begin
  Form1.Label2.Caption := inttostr ( Form1.TrackBar1.Position );
end;

procedure TForm1.TrackBar2Change(Sender: TObject);
begin
  Form1.Label3.Caption := inttostr ( Form1.TrackBar2.Position );
end;

procedure TForm1.TrackBar6Change(Sender: TObject);
begin
  Form1.Label7.Caption := inttostr ( Form1.TrackBar6.Position );
end;

procedure TForm1.TrackBar7Change(Sender: TObject);
begin
  Form1.Label9.Caption := inttostr ( Form1.TrackBar7.Position );
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  fClosing := true;
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
 Application.Terminate;
end;

end.
